PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Programming/Programming Tools/Dialog Manager Da shell/DialogManagerDA.Pas

Pascal/Delphi Source File | 1986-11-26 | 14.3 KB | 492 lines | [TEXT/ttxt]

PROGRAM   DialogManagerDA;

(* Desk accessory to show the structure of DAs    Beta version 0.9 __ 11/22/86
    by William S. Johnson, with help from the MACincinnati Hacker Group.
    Written in TML Pascal, version 2.0

This desk accessory is a shell you can use to understand the structure of DAs and how to use the Dialog
Manager from a desk accessory. It makes use of buttons, ICONs, radio buttons, text boxes, and does
some drawing of its own. Its most useful feature will adjust your MAC to Daylight Savings Time......*)

USES MacIntf;

CONST    {dialog item list}
        DefButton    = 1;        Chk_On        = 1;    {check on/off radio buttons}
        QuitButton    = 2;        Chk_Off        = 0;
        AboutButton    = 3;
        Tbox        = 4;        CNTL_enable    = 0;    {enable controls}
        TboxII        = 5;        CNTL_disable    = 255;
        RadioBut1    = 6;
        RadioBut2    = 7;        NoStrings    = 3;    { # of global strings }
        RadioBut3    = 8;
        BullsICON    = 9;
        TEnterICON    = 10;
        TimeButton    = 11;
        ResetButton    = 12;

TYPE
    EventPointer = ^EventRecord;
    Lptr = ^longint;
    str25 = string[25];            { define a short string to consume less global space }

    DAGlobals = record            { Global data. Store a handle to it in Device.dctlStorage }
        Finished :    boolean;
        ButtonNo :    longint;
        Number:        longint;
        NoText :        longint;
        menuHand :    menuHandle;
        StringArray :    array[1..NoStrings] of str25;
    end;

    DAGlobalsP = ^DAGlobals;        { define handle to DAGlobals record }
    DAGlobalsH = ^DAGlobalsP;

    DeviceControlRec = record        {replace predefined DCtlEntry record in interface files }
        dCtlDriver :    Handle;
        dCtlFlags :    Integer;
        dCtlQueue :    Integer;
        dCtlQhead :    Lptr;
        dCtlQtail :    Lptr;
        dCtlPosition :    longint;
        dCtlStorage :    DAGlobalsH;    {define as handle to global data}
        dCtlRefNum :    integer;
        dCtlCurTicks :    longint;
        dCtlWindow :    GrafPtr;
        dCtlDelay :    integer;
        dCtlEmask :    integer;
        dCtlMenu :    integer;
    end;

PROCEDURE ItemActivate (theDialog : DialogPtr;ItemNo, HiliteMode : integer);    { Activate & hilite buttons }
Var
    ItemType: Integer;
    ItemBox:  Rect;
    ItemHdl :  Handle;
Begin
    GetDItem(theDialog,ItemNo,ItemType,ItemHdl,ItemBox);
    HiliteControl(ControlHandle(ItemHdl),HiliteMode);
End;

PROCEDURE SetRadioButton (theDialog : DialogPtr; ItemNo, ChkMark : integer); { set on/off radio buttons }
Var
    ItemType: Integer;
    ItemBox:  Rect;
    ItemHdl:  Handle;
Begin
    GetDItem(theDialog,ItemNo,ItemType,ItemHdl,ItemBox);
    SetCtlValue(ControlHandle(ItemHdl), ChkMark);
End;

FUNCTION GetTxtValue (theDialog : DialogPtr; ItemNo : Integer): longint;    { get integer from text box }
Var
    ItemType    : Integer;
    ItemBox    : Rect;
    ItemHdl    : Handle;
    theString    : Str255;
    Value    : longint;
begin
    GetDItem(theDialog, ItemNo, ItemType, ItemHdl, ItemBox);
    GetIText(ItemHdl, theString);
    StringToNum (theString, Value);
    GetTxtValue := Value;
end;

PROCEDURE HiliteDefButton (theDialog: DialogPtr);
var
    ItemType:    Integer;
    ButtRect:    rect;
    ItemHdl :        Handle;
begin
    PenSize(3,3);                                {set pen size}
    GetDItem(theDialog,1,ItemType,ItemHdl,ButtRect);
    InsetRect(ButtRect,-4,-4);
    FrameRoundRect(ButtRect,28,28);
    PenSize(1,1);                                {reset pen size}
end;

PROCEDURE DrawEText (VAR DataRec: DAGlobals);        { put text from Globals in dialog }
Var
    VLoc, counter:    integer;
Begin
    with DataRec do begin
        TextFont(3);    { make Geneva 9 pt. the current font }
        TextSize(9);
        for counter := 1 to NoText do begin
            VLoc := 80 + (counter*14);
            MoveTo(12,VLoc);
            DrawString ( StringArray[counter] );
        end;    {with DataRec do - for counter}
        TextFont(0);    { make Chicago 12 pt. the current font }
        TextSize(12);
    end;
End;

PROCEDURE DitlText(VAR DataRec: DAGlobals);    { Draw text and output data in main window }
var
    aString    : str255;
begin
    with DataRec do begin
        if (NoText > 0) then DrawEText (DataRec);
        if (Number>0) then begin        { draw result of multiplication }
            MoveTo(300,76);
            NumToString (Number, aString);
            DrawString (aString);
        end;
    end;
end;

PROCEDURE DitlLines;        { draw dotted lines in main window }
var
    Pattrn :        Pattern;
begin
    GetIndPattern(Pattrn,0,4);    {set pen pattern to gray}
    PenPat(Pattrn);
    MoveTo(182,40);            { vertical line }
    Line(0,194);
    MoveTo(300,80);            { horizontal line }
    Line(50,0);
    GetIndPattern(Pattrn,0,1);    {reset pen pattern to black}
    PenPat(Pattrn);
end;

PROCEDURE InitDlogStatus(VAR device: DeviceControlRec);    { set buttons, globals, and cursor location }
Begin
    with device do begin
        SetRadioButton(DctlWindow, RadioBut1, Chk_On);
        SetRadioButton(DctlWindow, RadioBut2, chk_off);
        SetRadioButton(DctlWindow, RadioBut3, chk_off);
        ItemActivate (DCtlWindow, ResetButton, CNTL_disable);
        dCtlStorage^^.ButtonNo := 1;
        dCtlStorage^^.NoText := 0;
        dCtlStorage^^.Number := 0;
        SelIText (DCtlWindow, Tbox, 0, 0);        {jumpstart cursor in 1st textbox}
    end;
End;

PROCEDURE DoAbout (DlogID    : longint);
Var
    item        : integer;
    ViewRect        : rect;    {size of dialog window}
    DITL_Hdl        : handle;
    AboutDptr    : GrafPtr;
Begin
    SetRect(ViewRect,68,50,444,220);    {dialog box size- lf,tp,rt,bot}
    DITL_Hdl := GetResource('DITL', DlogID);
    if DITL_Hdl <> nil then begin
        AboutDptr:= NewDialog(Nil,        {Use _NewDialog_ to put up one of 2 different DITLs }
                        ViewRect,     {size of this dialog box}
                        'About Dialog',    {title of this dialog - unused}
                        True,        {dialog visible upon creation}
                        dBoxProc,    {modal type}
                        POINTER(-1),    {make it the frontmost window}
                        False,        {no goAway box in the dialog}
                        0,            {RefCon variable in dialog record}
                        DITL_Hdl);    {handle to the dialog itemlist}
        ModalDialog(nil,item);
        DisposDialog(AboutDptr);
        DetachResource(DITL_Hdl);
    end;
End;

PROCEDURE EnterText ( VAR Device: DeviceControlRec);
Var
    LoadDptr            : DialogPtr;
    itemno, ItemType    : integer;
    ItemBox            : Rect;
    ItemHdl            : Handle;
    theString            : Str255;
Begin
    LoadDptr:= GetNewDialog (device.dCtlMenu + 1, Nil, pointer(-1));
    ModalDialog(nil, ItemNo);
    With Device.Dctlstorage^^ do begin
        NoText := NoText + 1;
        GetDItem(LoadDptr, 2, ItemType, ItemHdl, ItemBox);
        GetIText(ItemHdl, theString);
        if (theString = '')
            then NoText := NoText - 1
            else StringArray[NoText] := copy (theString, 1, 25);
        end;
    DisposDialog(LoadDptr);
End;

PROCEDURE UpdateDA(VAR device: DeviceControlRec);    { update call - draw window contents }
begin
    with device do begin
        BeginUpdate(DialogPtr(dctlWindow));
        DrawDialog(DialogPtr(dctlWindow));
        DitlLines;
        DitlText(dCtlStorage^^);
        HiliteDefButton (DialogPtr(dctlWindow));
        EndUpdate(DialogPtr(dctlWindow));
    end;
end;

PROCEDURE DAactivate(VAR device: DeviceControlRec);        { activate call - put menu on menu bar }
begin
    with device do
        with dCtlStorage^^ do begin
            menuHand^^.menuID := DCtlMenu;
            InsertMenu (menuHand,0);
            DrawMenuBar;
        end;
end;

PROCEDURE DAdeactivate(VAR device: DeviceControlRec);   { deactivate - remove menu from menu bar }
begin
    DeleteMenu(Device.DCtlMenu);
    DrawMenuBar;
end;    { of DAdeactivate }

PROCEDURE CtlRadioButtons (VAR Device : DeviceControlRec; WhichButton : integer);
Begin
    with device.dctlstorage^^ do begin
        SetRadioButton (Device.DCtlWindow, ButtonNo + 5, chk_off);
        SetRadioButton (Device.DCtlWindow, WhichButton + 5, Chk_On);
        ButtonNo := WhichButton;
    end;
End;

PROCEDURE DoDefButton(VAR Device: DeviceControlRec);
Var
    NumOne, NumTwo    : longint;
    BigRec        : rect;
Begin
    with device do begin
        SetRect(BigRec,-999,-999,999,999);
        ItemActivate (DCtlWindow, ResetButton, CNTL_enable);
        NumOne := GetTxtValue(dctlWindow, Tbox);
        NumTwo := GetTxtValue(dctlWindow, TboxII);
        dctlstorage^^.Number := NumOne  * NumTwo;
        EraseRect(BigRec);
        InvalRect(BigRec);    {force update}
    end;
End;

PROCEDURE DoResetButton(VAR Device: DeviceControlRec);
Var
    BigRec        : rect;
Begin
    SetRect(BigRec,-999,-999,999,999);
    InitDlogStatus(device);
    EraseRect(BigRec);
    InvalRect(BigRec);    {force update}
End;

PROCEDURE DoTimeButton(VAR Device: DeviceControlRec);
Var
    OSErr                : integer;
    DismissItem            : longint;
    TimeAdjust, TimeInSec    : longint;
Begin
    DismissItem := Alert(device.dCtlMenu + 1, nil);
    TimeAdjust := 0;
    case DismissItem of
        2:    TimeAdjust := 3600;
        3:    TimeAdjust := -3600;
        end;
    GetDateTime (TimeInSec);
    OSErr := SetDateTime (TimeInSec + TimeAdjust);
End;

PROCEDURE doKeyEvent (VAR Device : DeviceControlRec; EventPtr : EventPointer);
Const        {key codes}
    CmdT    = $74;        Return    = $03;        Zero    = $30;
    CmdR    = $72;        Enter    = $0D;        Nine    = $39;
    CmdQ    = $71;        Tab        = $09;
    CmdB    = $62;        Backspace = $08;
Var
    item, charCode : integer;
    tmpDPtr        : DialogPtr;
    aFlag        : boolean;    { used as dummy variable in calling DialogSelect }
    ButNum        : longint;        { used to set button in CtlRadioButton, & in Delay call }
Begin
    with EventPtr^ do
        with device.dctlstorage^^ do begin
            charCode := BitAnd(message, charCodeMask);
            if BitAnd (modifiers, cmdKey) <> 0
                then case charCode of        { ====== field allowable command keys ====== }
                    CmdB:    { rotate radio buttons }
                        begin
                            if (ButtonNo = 3)
                                then ButNum := 1
                                else ButNum := ButtonNo + 1;
                            CtlRadioButtons (Device, ButNum);
                        end;
                    CmdR:
                        DoResetButton(device);
                    CmdT:
                        DoTimeButton(device);
                    CmdQ: { Quit }
                        Finished := True;
                    otherwise
                        Sysbeep(1);    { ignore all other command keys }
                    end        {of case}
                else begin                    { ======== handle all other keys ======== }
                    if (charCode >= Zero) and (charCode <= Nine)    { ===allow numeric keys=== }
                        then aFlag := DialogSelect (EventPtr^, tmpDptr, item)
                        else case charcode of    { ===== allow some non-numeric keys===== }
                            Return, Enter:
                                begin
                                    ItemActivate (Device.DCtlWindow, Defbutton, inButton);
                                    Delay(15, ButNum);
                                    ItemActivate (Device.DCtlWindow, Defbutton, CNTL_enable);
                                    DoDefButton(device);
                                end;
                            Tab, Backspace:
                                aFlag := DialogSelect (EventPtr^, tmpDptr, item);
                            otherwise
                                Sysbeep(1);    { ignore all other keys }
                        end;  { of case charcode - non-numeric keys }
                    end;  { of non-command keys }
        end;  { with device.dctlstorage^^ }
End;

PROCEDURE Event(VAR Device    : DeviceControlRec;
                VAR Block    : ParamBlockRec);
Var
    item, DismissItem    : integer;
    tmpDPtr            : DialogPtr;
    EventPtr            : EventPointer;
    aFlag            : boolean;    { used as dummy variable in calling DialogSelect }
    lastVal            : longint;        { used as dummy variable in DELAY proc }
Begin
    blockMove(@block.csParam[0],@EventPtr,4);
    with device.dctlstorage^^ do begin
        case EventPtr^.what of
            MouseDown:
                begin
                if DialogSelect (EventPtr^, tmpDptr, item) then    { process if item is enabled }
                    case Item of
                        Defbutton:
                            DoDefButton(device);
                        Aboutbutton:
                            DoAbout(device.dctlMenu + 1);
                        QuitButton:
                            Finished := True;
                        ResetButton:
                            DoResetButton(device);
                        TimeButton:
                            DoTimeButton(device);
                        BullsICON:
                            DismissItem := Alert(device.dCtlMenu, nil);
                        TEnterICON:
                            If (NoText < NoStrings) then begin
                                EnterText (device);
                                DitlText(device.dctlStorage^^);
                            end;
                        RadioBut1:
                            CtlRadioButtons (Device, 1);
                        RadioBut2:
                            CtlRadioButtons (Device, 2);
                        RadioBut3:
                            CtlRadioButtons (Device, 3);
                        otherwise;    { ignore all other mousedowns }
                    end;   { if DialogSelect/case of item hit }
                end;   { MouseDown case }
            KeyDown:
                doKeyEvent (device, EventPtr);
            UpdateEvt:
                UpdateDA(device);
            ActivateEvt:
                if odd(EventPtr^.modifiers)
                    then DAactivate(device)
                    else DAdeactivate(device);
            otherwise;    { ignore all other events }
        end; { case of what }
    end;   { with EventRecord }
end; { Event Procedure }

PROCEDURE Open(VAR Device : DeviceControlRec; VAR Block : ParamBlockRec);
VAR
    TmpPtr:        Ptr;
    WPeek:        WindowPeek;
    ResourceID:    Integer;    {ID to the dialog item list & main reference ID for resources}
BEGIN    {  Open Procedure  }
    ResourceID := $BFE0 + 32 * (-Device.DCtlRefNum);            { Compute main resource ID }
    Device.dCtlMenu := ResourceID;
    if Device.DctlWindow = nil then begin
        Device.DctlStorage :=  DAGlobalsH(NewHandle(132));
        TmpPtr := NewPtr($1000);                { Create hole in the heap under Window record }
        Device.DCtlWindow:= GetNewDialog (ResourceID, Nil, pointer(-1));
        WPeek := pointer(ord(Device.DCtlWindow));
        WPeek^.WindowKind := Device.DCtlRefNum;    {set the WindowKind field to the DA RefNum }
        SetPort(Device.DCtlWindow);
        DisposPtr(TmpPtr);

        HLock (Handle (Device.dCtlstorage));
        With Device.dCtlstorage^^ do begin
            InitDlogStatus(device);
            Finished := False;                 { set program terminator to false }
            menuHand := GetMenu (ResourceID);
        end;
        HUnlock(Handle(Device.Dctlstorage));
    end;
END;  { of Open }

PROCEDURE Ctl (VAR Device : DeviceControlRec; VAR Block : ParamBlockRec);
CONST
    accEvent        = 64;    accUndo        = 68;    accClear        = 73;
    accRun        = 65;    accCut        = 70;    CmdMenuNo    = 1;
    accCursor    = 66;    accCopy        = 71;    AboutMenuNo    = 3;
    accMenu        = 67;    accPaste        = 72;    QuitMenuNo    = 4;
VAR
    Done    : boolean;     { local pgm terminator - for calling CloseDeskAcc after globals unlocked }
    DPeek    : DialogPeek;
BEGIN { Main body of CTL Procedure }
    BitClr(@Device.dCtlFlags, 5);            { prevent CTL calls until done, since we use modaldialogs }
    SetPort(Device.DCtlWindow);            { Set the current grafport }
    HLock(Handle(Device.DCtlStorage));        { lock DAGlobals down }
    Done := False;                        { set local boolean program terminator }
    with device.dctlStorage^^ do
        with block do begin
            case csCode of
                accEvent:
                    Event(Device, Block);
                accRun:
                        begin
                        DPeek := DialogPeek(Device.DCtlWindow);
                        TEIdle (DPeek^.textH);        { blink caret in text box }
                         end;
                accCursor: ;
                accMenu:
                        begin
                        case csParam[1] of
                            CmdMenuNo:
                                DoAbout(device.dctlMenu + 3);
                            AboutMenuNo:
                                DoAbout(device.dctlMenu + 1);
                            QuitMenuNo:
                                    Finished := True;
                        end;  { case of menu }
                        HiliteMenu(0);
                        end;    { menu case}
                accUndo:   ;
                accCut:    ;
                accCopy:   ;
                accPaste:  ;
                accClear:  ;
            end;    { case of csCode }
            Done := Finished;
        end;    { of Block/device.dctlStorage^^ }
    HUnLock(Handle(Device.DCtlStorage));
    BitSet(@Device.dCtlFlags, 5);                {Allow _Control calls again.}
    if Done then CloseDeskAcc(Device.DCtlRefNum);
END;  { of Ctl }

PROCEDURE Close(VAR Device: DeviceControlRec;  VAR Block : ParamBlockRec);
BEGIN
    DAdeactivate(device);
    with Device do
        begin
            disposDialog(DialogPtr(dCtlWindow));    { dispose of window }
            ReleaseResource (Handle (DCtlStorage^^.menuHand));
            HPurge(Handle(dCtlDriver));
            dctlWindow := nil;
            disposHandle(Handle(dCtlStorage));        { Release private storage area }
            dctlStorage := nil;
        end;
END;  { of Close }

BEGIN     { No main program }
END.